VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form FrmImportarPrecios 
   Caption         =   "Base de datos DACLI 3"
   ClientHeight    =   6645
   ClientLeft      =   60
   ClientTop       =   420
   ClientWidth     =   9150
   LinkTopic       =   "Form1"
   ScaleHeight     =   6645
   ScaleWidth      =   9150
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command5 
      Caption         =   "EXCEL"
      Height          =   375
      Left            =   7440
      TabIndex        =   7
      Top             =   960
      Width           =   1575
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Pacientes"
      Height          =   375
      Left            =   4800
      TabIndex        =   6
      Top             =   480
      Width           =   1095
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Herramientas"
      Height          =   375
      Left            =   6000
      TabIndex        =   5
      Top             =   960
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Importar"
      Height          =   375
      Left            =   4800
      TabIndex        =   4
      Top             =   960
      Width           =   1095
   End
   Begin MSComDlg.CommonDialog cd1 
      Left            =   8040
      Top             =   3000
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "BASE DE DATOS DACLI | DACLI.MDB"
   End
   Begin VB.ListBox List1 
      Height          =   3960
      Left            =   480
      TabIndex        =   3
      Top             =   1680
      Width           =   6975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Buscar"
      Height          =   375
      Left            =   3480
      TabIndex        =   2
      Top             =   960
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   600
      TabIndex        =   1
      Top             =   960
      Width           =   2655
   End
   Begin VB.Label Label1 
      Caption         =   "BASE DE DATOS DACLI 3"
      Height          =   255
      Left            =   600
      TabIndex        =   0
      Top             =   600
      Width           =   2655
   End
End
Attribute VB_Name = "FrmImportarPrecios"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DACLI3 As DAO.Database
Private Sub Command1_Click()
    cd1.InitDir = "C:\DACLI3\"
    cd1.ShowOpen
    Text1.Text = cd1.FileName
    Set DACLI3 = OpenDatabase(Text1.Text)
    List1.Clear
    List1.AddItem "Base de datos agregada"
End Sub
Sub ImportarPacientes()
    Dim texad3 As DAO.Recordset
    Dim tpac As DAO.Recordset
    
    Set texad3 = DACLI3.OpenRecordset("select *from paciente")
    Set tpac = Base.OpenRecordset("paciente")
    c = 0
    
    Base.Execute "delete from paciente"
    While Not texad3.EOF
        tpac.AddNew
            tpac(0) = texad3(0)
            tpac(1) = texad3(1)
            tpac(2) = texad3(2)
            tpac(3) = texad3(3)
            tpac(4) = texad3(4)
            tpac(5) = texad3(5)
            tpac(6) = texad3(6)
        tpac.Update
       c = c + 1
       List1.AddItem c & " " & texad3(1)
        texad3.MoveNext
    Wend
    MsgBox "Total de pacientes importados " & c
        

End Sub

Private Sub Command2_Click()
    Dim texad3 As DAO.Recordset
    Dim tnpd3 As DAO.Recordset
    
    Set texad3 = DACLI3.OpenRecordset("select *from examenes")
    Base.Execute "delete from examenes"
    List1.AddItem "Incializando la Tabla Examenes.......100%"
    Base.Execute "delete from precios"
    List1.AddItem "Incializando la Tabla Precios.......100%"
    Base.Execute "delete from perfiles"
    Base.Execute "delete from valores"
    Base.Execute "delete from PerfilResultados"
    While Not texad3.EOF
        
        Base.Execute "insert into EXAMENES (Cod_Examen,Descripcion,IdGrupo,PERFIL,RECEPCION) values (" _
                     & "" & texad3(0) & ",'" & texad3("descripcion") & "'," & 0 & ",FALSE,TRUE)"
        List1.AddItem "Copiando [" & texad3("descripcion") & "].......100%"
        
        Set tnpd3 = DACLI3.OpenRecordset("select *from NOMBREPRECIOS")
        cont = 2
        While Not tnpd3.EOF
                If texad3(cont) > 0 Then
                np = tnpd3(0)
                precio = texad3(cont)
                cod = texad3(0)
                Base.Execute "insert into precios(Cod_Examen,NombrePrecio,Monto) values( " _
                & "" & cod & "," _
                & "'" & np & "'," _
                & "" & COMAPORPUNTO(precio) & ")"
            End If
             cont = cont + 1
            tnpd3.MoveNext
        Wend
        
        
            List1.List(List1.ListCount - 1) = List1.List(List1.ListCount - 1) & "..[Precios]"
            DoEvents
        
        
        texad3.MoveNext
        DoEvents
    
    Wend
    Base.Execute "update examenes set idGrupo=1 where idGrupo=0"
    
End Sub

Private Sub Command3_Click()
    FrmHerramienta.Show vbModal

End Sub

Private Sub Command4_Click()
    Me.ImportarPacientes
 End Sub
 Function agregarExamen(examen, cate)
n = AutoNumero("cod_examen", "examenes")
Dim t As DAO.Recordset
Set t = Base.OpenRecordset("examenes")
    t.AddNew
        t(0) = n
        t(1) = examen
        t(2) = cate
        t("recepcion") = True
    t.Update
agregarExamen = n
End Function
Function agregarVALOR(examen, valor)
Set t = Base.OpenRecordset("valores ")
If Len(valor) = 0 Then Exit Function
    t.AddNew
        t(0) = examen
        t(1) = valor
    t.Update

End Function
Function agregarPrecio(examen, precio, nombreprecio)
Set t = Base.OpenRecordset("PRECIOS ")
If IsNull(precio) Then Exit Function
If Val(precio) <= 0 Then Exit Function
    t.AddNew
        t(0) = examen
        t(1) = nombreprecio
        t(2) = precio
    t.Update

End Function

Private Sub Command5_Click()
    Dim t As DAO.Recordset
    If MsgBox("desea borrar", vbYesNo) = vbYes Then
        Base.Execute "delete from precios"
        Base.Execute "delete from valores"
        Base.Execute "delete from examenes"
        
    End If
    Set t = Base.OpenRecordset("select *from importar")
    While Not t.EOF
        examen = t(0)
        CAT = t(1)
        n = agregarExamen(examen, CAT)
        agregarVALOR n, t("valor1")
        agregarVALOR n, t("valor2")
        agregarVALOR n, t("valor3")
        agregarVALOR n, t("valor4")
        agregarVALOR n, t("valor5")
        agregarVALOR n, t("valor6")
        agregarVALOR n, t("valor7")
        agregarVALOR n, t("valor8")
        agregarVALOR n, t("valor9")
        agregarVALOR n, t("valor10")
        agregarVALOR n, t("valor11")
        agregarVALOR n, t("valor12")
        agregarVALOR n, t("valor13")
        agregarVALOR n, t("valor14")
        agregarVALOR n, t("valor15")
        agregarVALOR n, t("valor16")
        agregarVALOR n, t("valor17")

        
        
        agregarPrecio n, t(2), "NORMAL"
        agregarPrecio n, t(3), "EMPR1"
        agregarPrecio n, t(4), "EMPR2"
        agregarPrecio n, t(5), "EMPR3"
        agregarPrecio n, t(6), "EMPR4"
        
        
        t.MoveNext
    Wend
    MsgBox "importados"

End Sub
